Gigarom 1/Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso/FILES/HYP/J-M/MenuUtils.cpt/Transfer Menu/background_2662.txt

Text File | 1989-04-13 | 11KB | 356 lines

-- background: 2662 from stack: in
-- bmap block id: 3080
-- flags: 0000
-- background id: 0
-- name:


-- part 1 (button)
-- low flags: 00
-- high flags: A000
-- rect: left=60 top=92 right=111 bottom=246
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Transfer Menu Demo
----- HyperTalk script -----
on mouseDown
  get HPopupMenu(cd fld "xtransfer",0,item 2 of the rect of the target+3,item 3 of the rect of the target-3)
  go this cd
  set cursor to watch
  if item 1 of it = 1 then
    set hilite of me to false
    visual iris close
    go to stack item (item 2 of it) of line (item 1 of it) of cd fld "xtransfer" of first cd
  else if item 1 of it = 3 then
    set hilite of me to false
    visual zoom open
    go this cd
    get item (item 2 of it) of line (item 1 of it) of cd fld "xtransfer" of first cd
    if "FontDA" is in it
    then get Strings("ReplacePhrase","FontDA","Font/DA", it)
    if "ReadySet" is in it
    then get Strings("ReplacePhrase","ReadySet","Ready,Set,", it)
    open it
  else if item 1 of it = 5 then
    resetStackList
  else if item 1 of it = 6 then resetApplicationList
end mouseDown
on resetStackList
  global stacks
  put "Stacks," & getCurrentFiles("STAK",stacks) into line 1 of cd fld "xtransfer"
end resetStackList
on resetApplicationList
  global applications
  put "Applications," & getCurrentFiles("APPL",applications) into line 3 of cd fld "xtransfer"
end resetApplicationList
function getCurrentFiles type, typeList
set cursor to busy
if first word of typeList is empty then return "(Not Available"
put empty into currentList
repeat with N = 1 to the number of lines in typeList
  set cursor to busy
  if first word of line N of typeList is not empty then
    if last char of line N of typeList is not ":" then put ":" after line N of typeList
    get files(line N of typeList,type)
    if it is not empty then
      if "," is in it then get Strings("DeleteChar",",", it)
      if "/" is in it then get Strings("DeleteChar", "/", it)
      put it & return after currentList
    end if
  end if
end repeat
delete last char of currentList
if first word of currentList is empty then return "(Not Available"
if the number of lines in currentList > 1 then
  put Strings("ReplaceChar", numToChar(13), ",", currentList) into currentList
  put Strings("SortItems", currentList) into currentList
end if
return currentList
end getCurrentFiles


-- part 2 (button)
-- low flags: 00
-- high flags: A000
-- rect: left=60 top=159 right=177 bottom=246
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: About Transfer Menu...
----- HyperTalk script -----
on mouseUp
  hide cd fld "about transfer"
end mouseUp
on mouseDown
  show cd fld "about transfer"
end mouseDown
on mouseLeave
  hide cd fld "about transfer"
end mouseLeave


-- part 3 (button)
-- low flags: 00
-- high flags: A000
-- rect: left=60 top=111 right=128 bottom=246
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Menu Installer
----- HyperTalk script -----
on mouseDown
  global btnLevel,btnType,btnFont,btnSize,btnSide
  get cd fld "options"
  put numToChar(18) before item btnLevel of line 1 of it
  put numToChar(18) before item btnType of line 2 of it
  put numToChar(18) before item btnFont of line 3 of it
  put numToChar(18) before item btnSize of line 4 of it
  put numToChar(18) before item btnSide of line 5 of it
  get HPopupMenu(it,0,item 2 of the rect of the target+1,item 3 of the rect of the target-3)
  set cursor to watch
  go this cd
  if item 1 of it > 0 and item 1 of it < 7 then
    resetCheckedItem item 1 of it, item 2 of it
  else if item 1 of it = 7 then
    visual zoom close
    lock screen
    unlock screen with zoom open
    put SFile("GetFile","STAK","the stack to install ‘Transfer Menu’") into fName
    set cursor to watch
    if fName is empty then exit mouseDown
    installButton fName
  end if
end mouseDown
on resetCheckedItem lineNR, newLevel
  global btnLevel,btnType,btnFont,btnSize,btnSide
  put item lineNR of "btnLevel,btnType,btnFont,btnSize,btnSide" into varName
  put Strings("GetGlobal",varName) into oldLevel
  put "   " before item oldLevel of line lineNR of cd fld "options"
  put first word of item newLevel of line lineNR of cd fld "options" & "       " into item newLevel of line lineNR of cd fld "options"
  get Strings("SetGlobal",varName,newLevel)
end resetCheckedItem
on installButton toFile
  global btnLevel,btnType,btnFont,btnSize,btnSide
  set cursor to watch
  put "...checking the stack you selected.  Please wait a second."
  lock screen
  set lockMessages to true
  push cd
  go stack toFile
  put 0 into temp
  if the number of cd flds > 0 then
    repeat with N = 1 to the number of cd flds
      if "xtransfer" is in short name of cd fld N then
        show cd fld N
        choose fld tool
        click at the loc of cd fld N
        doMenu "Cut Field"
        choose browse tool
      end if
    end repeat
  end if
  pop cd
  set lockMessages to false
  unlock screen
  hide msg
  ask "Please name your new 'Transfer' button:" with "Transfer"
  if it is empty then exit installButton
  put it into buttonName
  put "...transferring resources.  Please wait."
  put the long name of this stack into fromFile
  put word 2 to 50 of fromFile into fromFile
  delete char 1 of fromFile
  delete last char of fromFile
  if not moveResources(fromFile,toFile) then exit installButton
  put "...resource installation successful! Stand by, please"
  put item btnType of ",card,bkgnd" into buttonLevel
  put item btnLevel of ",shadow,transparent,opaque,rectangle" into buttonStyle
  put item btnFont of ",Chicago,Geneva,Monaco,New York" into buttonFont
  put item btnSize of ",9,10,12,18,24" into buttonSize
  put cd fld "protoField" into protoField
  put cd fld "protoScript" into theScript
  put line 1 of cd fld (item btnSide of ",bottom,right,center") into line 2 of theScript
  set hilite of the target to false
  closeCard
  set lockMessages to true
  visual barn door open
  go stack toFile
  lock screen
  put Strings("ReplaceWord","xxxx",last word of the id of this cd,theScript) into theScript
  get the number of cd flds + 1
  doMenu "New Field"
  hide cd fld it
  set name of cd fld it to "xtransfer"
  put protoField into cd fld it
  if buttonLevel is "bkgnd" then
    doMenu "Background"
    get the number of bg btns + 1
    doMenu "New Button"
    set name of bg btn it to buttonName
    set style of bg btn it to buttonStyle
    set textFont of bg btn it to buttonFont
    set textSize of bg btn it to buttonSize
    set script of bg btn it to theScript
    doMenu "Background"
  else
    get the number of cd btns + 1
    doMenu "New Button"
    set name of cd btn it to buttonName
    set style of cd btn it to buttonStyle
    set textFont of cd btn it to buttonFont
    set textSize of cd btn it to buttonSize
    set script of cd btn it to theScript
  end if
  choose browse tool
  unlock screen
  beep 3
  if buttonLevel is "bkgnd" then
    repeat 3
      set hilite of bg btn buttonName to true
      set hilite of bg btn buttonName to false
    end repeat
  else
    repeat 3
      set hilite of cd btn buttonName to true
      set hilite of cd btn buttonName to false
    end repeat
  end if
  put "please move '" & buttonName & "' button to the desired location..."
  wait 3 secs
  put "...then type 'Command-Tab' (wait, there’s more)"
  wait 3 secs
  put "you have to Restart HyperCard before the button will work"
  wait 3 secs
  put "...we're done playin', now!"
  wait 1 second
  hide msg
  choose btn tool
  if buttonLevel is "bkgnd" then
    click at the loc of bg btn buttonName
  else click at the loc of cd btn buttonName
end installButton
function moveResources fromFile,toFile
if not copyResources(fromFile,toFile) then
  hide msg
  beep
  answer "Sorry, there was a problem transferring resources. Please try again." with "Cancel"
  return false
else return true
end moveResources
function copyResources fromFile,toFile
ResCopy fromFile,toFile,"XFCN","Strings"
if "error" is in the result then return false
ResCopy fromFile,toFile,"XFCN","SFile"
if "error" is in the result then return false
ResCopy fromFile,toFile,"XFCN","Files"
if "error" is in the result then return false
ResCopy fromFile,toFile,"XFCN","HPopUpMenu"
if "error" is in the result then
  return false
else return true
end copyResources



-- part 4 (button)
-- low flags: 00
-- high flags: E000
-- rect: left=60 top=126 right=144 bottom=246
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: More FREEware & S/W...
----- HyperTalk script -----
on mouseUp
  set hilite of me to true
  if not visible of cd fld "freeware" then
    repeat 2
      set hilite of me to false
      set hilite of me to true
    end repeat
    click at 465,72
    lock screen
    show cd fld "freeware"
    unlock screen with zoom open
  else send mouseUp to cd fld "freeware"
end mouseUp


-- part 5 (button)
-- low flags: 00
-- high flags: 0000
-- rect: left=59 top=59 right=91 bottom=248
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name:
----- HyperTalk script -----
on mouseDown
  if visible of cd fld "freeware" then click at the loc of cd fld "freeware"
  if hilite of me then
    repeat 2
      set hilite of me to false
      set hilite of me to true
    end repeat
    show cd btn "blank"
    set hilite of me to false
  else
    set hilite of me to true
    hide cd btn "blank"
  end if
end mouseDown


-- part 6 (button)
-- low flags: 00
-- high flags: A000
-- rect: left=60 top=176 right=194 bottom=246
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: About STaK-X...
----- HyperTalk script -----
on hideMe
  repeat 3
    set hilite of me to false
    set hilite of me to true
  end repeat
  set hilite of me to false
  hide cd fld "About"
  click at the loc of bg btn "More FreeWare & S/W..."
end hideMe
on mouseUp
  hideMe
end mouseUp
on mouseDown
  show cd fld "About"
end mouseDown
on mouseLeave
  hide cd fld "About"
end mouseLeave